home *** CD-ROM | disk | FTP | other *** search
/ Sprite 1984 - 1993 / Sprite 1984 - 1993.iso / src / lib / tclX6.4c / dist / tests / profile.test < prev    next >
Encoding:
Text File  |  1992-11-07  |  9.5 KB  |  298 lines
  1. #
  2. # profile.test
  3. #
  4. # Tests for the profile command and profrep procedure.
  5. #---------------------------------------------------------------------------
  6. # Copyright 1992 Karl Lehenbauer and Mark Diekhans.
  7. #
  8. # Permission to use, copy, modify, and distribute this software and its
  9. # documentation for any purpose and without fee is hereby granted, provided
  10. # that the above copyright notice appear in all copies.  Karl Lehenbauer and
  11. # Mark Diekhans make no representations about the suitability of this
  12. # software for any purpose.  It is provided "as is" without express or
  13. # implied warranty.
  14. #------------------------------------------------------------------------------
  15. # $Id: profile.test,v 2.0 1992/10/16 04:50:07 markd Rel $
  16. #------------------------------------------------------------------------------
  17. #
  18.  
  19. if {[info procs test] != "test"} then {source testlib.tcl}
  20.  
  21. #
  22. # Function to build a list from the profile output data with each entry
  23. # contain the call stack and call count.  The list is returned sorted by
  24. # call stack.
  25. #
  26.  
  27. proc SumCntData {profDataVar} {
  28.     upvar $profDataVar profData
  29.     set sumData {}
  30.     foreach stack [array names profData] {
  31.         lappend sumData [list $stack [lindex $profData($stack) 0]]
  32.     }
  33.     return [lsort $sumData]
  34. }
  35.  
  36. proc ProcA1 {} {ProcB1}
  37. proc ProcB1 {} {ProcC1;ProcC1}
  38. proc ProcC1 {} {}
  39.  
  40. Test profile-1.1 {profile count tests} {
  41.    profile on
  42.    ProcA1
  43.    profile off profData
  44.    SumCntData profData
  45. } 0 [list {<global> 1} \
  46.           {{ProcA1 <global>} 1} \
  47.           {{ProcB1 ProcA1 <global>} 1} \
  48.           {{ProcC1 ProcB1 ProcA1 <global>} 2}]
  49.  
  50. proc ProcA2 {} {ProcB2}
  51. proc ProcB2 {} {ProcC2}
  52. proc ProcC2 {} {uplevel ProcD2; ProcD2}
  53. proc ProcD2 {} {}
  54.  
  55. Test profile-1.2 {profile count tests} {
  56.    profile on
  57.    ProcA2
  58.    profile off profData
  59.    SumCntData profData
  60. } 0 [list {<global> 1} \
  61.           {{ProcA2 <global>} 1} \
  62.           {{ProcB2 ProcA2 <global>} 1} \
  63.           {{ProcC2 ProcB2 ProcA2 <global>} 1} \
  64.           {{ProcD2 ProcB2 ProcA2 <global>} 1} \
  65.           {{ProcD2 ProcC2 ProcB2 ProcA2 <global>} 1}]
  66.  
  67. proc ProcA3 {} {ProcB3}
  68. proc ProcB3 {} {catch {ProcC3};ProcE3}
  69. proc ProcC3 {} {ProcD3}
  70. proc ProcD3 {} {error baz}
  71. proc ProcE3 {} {}
  72.  
  73. Test profile-1.3 {profile count tests} {
  74.    profile on
  75.    ProcA3
  76.    profile off profData
  77.    SumCntData profData
  78. } 0 [list {<global> 1} \
  79.           {{ProcA3 <global>} 1} \
  80.           {{ProcB3 ProcA3 <global>} 1} \
  81.           {{ProcC3 ProcB3 ProcA3 <global>} 1} \
  82.           {{ProcD3 ProcC3 ProcB3 ProcA3 <global>} 1} \
  83.           {{ProcE3 ProcB3 ProcA3 <global>} 1}]
  84.  
  85. #
  86. # Function to build a list from the profile output data with each entry
  87. # contain the call stack and call count.  The list is returned sorted by
  88. # CPU time.  CPU time is not included in the return, since it can't be
  89. # verified exactly, only approximately.
  90. #
  91.  
  92. proc SumCpuData {profDataVar} {
  93.     upvar $profDataVar profData
  94.     set sumData {}
  95.     foreach stack [array names profData] {
  96.         lappend sumData [list [format %032d [lindex $profData($stack) 2]] \
  97.                               $stack [lindex $profData($stack) 0]]
  98.     }
  99.     set retData {}
  100.     foreach entry $sumData {
  101.         lappend retData [lrange $entry 1 end]
  102.     }
  103.     return [lsort $retData]
  104. }
  105.  
  106. proc EatTime {amount} {
  107.     set end   [expr [lindex [times] 0]+$amount]
  108.     while {[lindex [times] 0] < $end} {
  109.         format %d 100  ;# kind of slow command.
  110.     }    
  111. }
  112.  
  113. proc ProcA4 {} {ProcB4;ProcC4;ProcD4}
  114. proc ProcB4 {} {EatTime 1}
  115. proc ProcC4 {} {EatTime 100}
  116. proc ProcD4 {} {EatTime 1000}
  117.  
  118. Test profile-2.1 {profile CPU time tests} {
  119.    profile on
  120.    ProcA4
  121.    profile off profData
  122.    SumCpuData profData
  123. } 0 [list {<global> 1} \
  124.           {{EatTime ProcB4 ProcA4 <global>} 1} \
  125.           {{EatTime ProcC4 ProcA4 <global>} 1} \
  126.           {{EatTime ProcD4 ProcA4 <global>} 1} \
  127.           {{ProcA4 <global>} 1} {{ProcB4 ProcA4 <global>} 1} \
  128.           {{ProcC4 ProcA4 <global>} 1} {{ProcD4 ProcA4 <global>} 1}]
  129.  
  130. proc ProcA1 {} {ProcB1;set a 1;incr a}
  131. proc ProcB1 {} {ProcC1;ProcC1}
  132. proc ProcC1 {} {set a 1;incr a}
  133.  
  134. Test profile-3.1 {profile -command tests} {
  135.    profile -commands on
  136.    ProcA1
  137.    profile off profData
  138.    SumCntData profData
  139. } 0 [list {<global> 1} \
  140.           {{ProcA1 <global>} 1} \
  141.           {{ProcB1 ProcA1 <global>} 1} \
  142.           {{ProcC1 ProcB1 ProcA1 <global>} 2} \
  143.           {{incr ProcA1 <global>} 1} \
  144.           {{incr ProcC1 ProcB1 ProcA1 <global>} 2} \
  145.           {{profile <global>} 1} {{set ProcA1 <global>} 1} \
  146.           {{set ProcC1 ProcB1 ProcA1 <global>} 2}]
  147.  
  148. Test profile-4.1 {profile error tests} {
  149.     profile off
  150. } 1 {wrong # args: profile [-commands] on|off arrayVar}
  151.  
  152. Test profile-4.2 {profile error tests} {
  153.     profile baz
  154. } 1 {expected one of "on" or "off", got "baz"}
  155.  
  156. Test profile-4.3 {profile error tests} {
  157.     profile -comman on
  158. } 1 {expected option of "-commands", got "-comman"}
  159.  
  160. Test profile-4.4 {profile error tests} {
  161.     profile -commands off
  162. } 1 {wrong # args: profile [-commands] on|off arrayVar}
  163.  
  164. Test profile-4.5 {profile error tests} {
  165.     profile -commands
  166. } 1 {wrong # args: profile [-commands] on|off arrayVar}
  167.  
  168. Test profile-4.6 {profile error tests} {
  169.     profile -commands on foo
  170. } 1 {wrong # args: profile [-commands] on|off arrayVar}
  171.  
  172. Test profile-4.7 {profile error tests} {
  173.     profile off foo
  174. } 1 {profiling is not currently enabled}
  175.  
  176. Test profile-4.8 {profile error tests} {
  177.     profile on
  178.     profile on
  179. } 1 {profiling is already enabled}
  180. profile off foo
  181.  
  182. #
  183. # Set up some dummy profile data for the report tests.  The data is not
  184. # realistic, but designed so that no two numbers that are sorted on are the
  185. # same.
  186. #
  187. catch {unset profData}
  188. set baz {EatTime ProcB4 ProcA4}
  189. set profData($baz) {4 800 10}
  190. set baz {ProcC4 ProcA4}
  191. set profData($baz) {3 1000 100}
  192. set baz {EatTime ProcC4 ProcA4}
  193. set profData($baz) {2 1000 100}
  194. set baz {ProcD4 ProcA4}
  195. set profData($baz) {1 100 1070}
  196. set baz ProcA4
  197. set profData($baz) {5 1250 1180}
  198. set baz {EatTime ProcD4 ProcA4}
  199. set profData($baz) {6 1070 1070}
  200. set baz {ProcB4 ProcA4}
  201. set profData($baz) {7 80 11}
  202.  
  203. #
  204. # Read the profile report into memory and purge the file
  205. #
  206. proc GetProfRep {fileName} {
  207.     set fh [open $fileName]
  208.     set data [read $fh]
  209.     close $fh
  210.     unlink $fileName
  211.     return $data
  212. }
  213.  
  214. rename SAVED_UNKNOWN unknown
  215.  
  216. Test profile-5.1 {profrep tests} {
  217.     profrep profData "calls" 1 prof.tmp "Profile Test 5.1"
  218.     GetProfRep prof.tmp
  219. } 0 {-----------------------------------------------------
  220. Profile Test 5.1
  221. -----------------------------------------------------
  222. Procedure Call Stack      Calls  Real Time   CPU Time
  223. -----------------------------------------------------
  224. ProcB4                        7         80         11
  225. ProcA4                        5       1250       1180
  226. EatTime                       4        800         10
  227. ProcC4                        3       1000        100
  228. ProcD4                        1        100       1070
  229. }
  230.  
  231. Test profile-5.2 {profrep tests} {
  232.     profrep profData "real" 1 prof.tmp "Profile Test 5.2"
  233.     GetProfRep prof.tmp
  234. } 0 {-----------------------------------------------------
  235. Profile Test 5.2
  236. -----------------------------------------------------
  237. Procedure Call Stack      Calls  Real Time   CPU Time
  238. -----------------------------------------------------
  239. ProcA4                        5       1250       1180
  240. ProcC4                        3       1000        100
  241. EatTime                       4        800         10
  242. ProcD4                        1        100       1070
  243. ProcB4                        7         80         11
  244. }
  245.  
  246. Test profile-5.3 {profrep tests} {
  247.     profrep profData "cpu" 1 prof.tmp "Profile Test 5.3"
  248.     GetProfRep prof.tmp
  249. } 0 {-----------------------------------------------------
  250. Profile Test 5.3
  251. -----------------------------------------------------
  252. Procedure Call Stack      Calls  Real Time   CPU Time
  253. -----------------------------------------------------
  254. ProcA4                        5       1250       1180
  255. ProcD4                        1        100       1070
  256. ProcC4                        3       1000        100
  257. ProcB4                        7         80         11
  258. EatTime                       4        800         10
  259. }
  260.  
  261. Test profile-5.4 {profrep tests} {
  262.     profrep profData "cpu" 2 prof.tmp "Profile Test 5.4"
  263.     GetProfRep prof.tmp
  264. } 0 {-----------------------------------------------------
  265. Profile Test 5.4
  266. -----------------------------------------------------
  267. Procedure Call Stack      Calls  Real Time   CPU Time
  268. -----------------------------------------------------
  269. ProcA4                        5       1250       1180
  270. ProcD4 ProcA4                 1        100       1070
  271. EatTime ProcD4                6       1070       1070
  272. ProcC4 ProcA4                 3       1000        100
  273. EatTime ProcC4                2       1000        100
  274. ProcB4 ProcA4                 7         80         11
  275. EatTime ProcB4                4        800         10
  276. }
  277.  
  278. Test profile-5.5 {profrep tests} {
  279.     profrep profData "cpu" 10 prof.tmp "Profile Test 5.5"
  280.     GetProfRep prof.tmp
  281. } 0 {------------------------------------------------------
  282. Profile Test 5.5
  283. ------------------------------------------------------
  284. Procedure Call Stack       Calls  Real Time   CPU Time
  285. ------------------------------------------------------
  286. ProcA4                         5       1250       1180
  287. ProcD4 ProcA4                  1        100       1070
  288. EatTime ProcD4 ProcA4          6       1070       1070
  289. ProcC4 ProcA4                  3       1000        100
  290. EatTime ProcC4 ProcA4          2       1000        100
  291. ProcB4 ProcA4                  7         80         11
  292. EatTime ProcB4 ProcA4          4        800         10
  293. }
  294.  
  295. unset foo
  296. rename unknown SAVED_UNKNOWN
  297.  
  298.